home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / forthcmp.zip / SCRDIF.4TH < prev    next >
Text File  |  1992-03-30  |  4KB  |  143 lines
  1. \  SCREEN FILE COMPARISON PROGRAM
  2.  
  3. \ COPYRIGHT (C) 1985 BY THOMAS ALMY.  ALL RIGHTS RESERVED.
  4.  
  5. \  Users of ForthCMP are given permission to use or distribute this
  6. \  program, as long as no charge is made and the credit message is maintained.
  7.  
  8. \ Uses memory for buffer area for maximum performance.
  9.  
  10. 100 MSDOS
  11. INCLUDE VARS
  12. INCLUDE DOS1
  13.  
  14. 0 CONSTANT FALSE
  15. -1 CONSTANT TRUE
  16. 1024 CONSTANT B/BLK
  17.  
  18. HCB FILE1
  19. HCB FILE2
  20.  
  21. VARIABLE DIFFLG  \ TRUE when differences exist
  22. VARIABLE SCR#    \ current screen number
  23. VARIABLE #BLKS   \ number of buffered block pairs
  24. VARIABLE ACT1    \ number filled for file 1
  25. VARIABLE ACT2    \ number filled for file 2
  26. VARIABLE BUF1ST  \ start of first buffer
  27. VARIABLE BUF2ST  \ start of second buffer
  28. VARIABLE INDX    \ index into buffers
  29.  
  30. 2 1 IN/OUT
  31. : SCR<> ( string1 string2  -- flag, true if different )
  32.     FALSE -ROT  B/BLK  0 ?DO
  33.       OVER I + C@  OVER I + C@
  34.            <> IF  ROT DROP TRUE -ROT LEAVE THEN
  35.       LOOP
  36.   2DROP ;
  37.  
  38. 0 0 IN/OUT
  39. : INITIALIZE-DATA
  40.   PAD DUP BUF1ST !  S0 @ 100 - OVER - 0  B/BLK 2* UM/MOD NIP
  41.   DUP #BLKS !  DUP ACT1 ! DUP ACT2 ! DUP INDX !
  42.   B/BLK * + BUF2ST !
  43.   DIFFLG OFF  SCR# OFF ;
  44.  
  45. 0 0 IN/OUT
  46. : FILL-BUFFERS
  47.     FILE1 BUF1ST @ #BLKS @ B/BLK * FREAD
  48.       0 B/BLK UM/MOD NIP  ACT1 !
  49.     FILE2 BUF2ST @ #BLKS @ B/BLK * FREAD
  50.       0 B/BLK UM/MOD NIP  ACT2 !
  51.   INDX OFF ;
  52.  
  53. : READ-SCREENS? ( -- addr1 addr2 flag1 flag2 )
  54.                 ( no addr'S if either flag is zero )
  55.   INDX @ #BLKS @ = IF FILL-BUFFERS THEN
  56.   INDX @ ACT1 @ = IF  FALSE INDX @ ACT2 @ <>  EXIT THEN
  57.   INDX @ ACT2 @ = IF  TRUE FALSE EXIT THEN
  58.   INDX @ B/BLK *  BUF1ST @ OVER +  SWAP BUF2ST @ +
  59.   TRUE TRUE
  60.   1 INDX +! ;
  61.  
  62. 0 0 IN/OUT
  63. : HELLO 
  64.   ." Forth Screenfile Comparison Program" CR
  65.   ." Copyright (C) 1985 by Thomas Almy.  All Rights Reserved"
  66.   ;
  67.  
  68. 1 0 IN/OUT
  69. : .DIFS ( scr# -- )
  70.   DIFFLG @ 0= IF CR ." Different: "  DIFFLG ON THEN
  71.   . ;
  72.  
  73. 2 0 IN/OUT
  74. : .LARGER ( firstfileflg scr#  -- ) SWAP  CR  DIFFLG ON
  75.   IF ." First" ELSE ." Second" THEN
  76.   ."  file larger, starting screen " . ;
  77.  
  78. 0 0 IN/OUT
  79. : ?THE-SAME  DIFFLG @ 0= IF CR ." Files are identical" THEN ;
  80.  
  81. 0 0 IN/OUT
  82. : COMPARE-SCREENS
  83.   BEGIN
  84.    READ-SCREENS?
  85.    2DUP AND WHILE ( both read )
  86.    2DROP
  87.    SCR<> IF SCR# @ .DIFS THEN
  88.    1 SCR# +!
  89.   REPEAT
  90.   OVER OR IF ( one reached eof first )
  91.        SCR# @ .LARGER
  92.           ELSE ( both ended )
  93.        DROP  ?THE-SAME
  94.       THEN ;
  95.  
  96. 1 0 IN/OUT
  97. : ?FNF IF CR ." File not found"  bye THEN ;
  98.  
  99. 1 0 IN/OUT
  100. : ADD.DEFAULT.EXTENSION ( handle -- )
  101.   2+ DUP >R  1+  ( ext string )
  102.   BEGIN COUNT DUP ASCII . = IF DROP BEGIN COUNT DUP 0=
  103.         IF R> DROP 2DROP EXIT THEN  DUP ASCII \ = SWAP ASCII / = OR UNTIL  1 THEN
  104.         0= UNTIL
  105.   DUP 1- ASCII . C<-  ( replace null with dot )
  106.   CNT" SCR"  0 DO COUNT 2 PICK C! SWAP 1+ SWAP LOOP
  107.   DROP ( extension address )
  108.   DUP 0 C<-  ( delimit string )
  109.   R@ - 1- R> C!   ( set length byte )
  110.   ; 
  111.  
  112. 0 0 IN/OUT
  113. : USAGE ( only one file specified )  CR
  114.   ." USAGE: SCRDIF [ filename1 filename2 ] " CR
  115.   bye ;
  116.  
  117. 0 0 IN/OUT
  118. : OPEN-FILES
  119.     129 TIB 128 C@ DUP #TIB ! CMOVE  \ get command line
  120.     BL WORD C@ 0= IF USAGE THEN    \ no args
  121.     HERE FILE1 NAME>HCB
  122.     FILE1 ADD.DEFAULT.EXTENSION
  123.     FILE1 O_RD FOPEN ?FNF
  124.     BL WORD C@ 0= IF USAGE THEN    \ no args
  125.     HERE FILE2 NAME>HCB
  126.     FILE2 ADD.DEFAULT.EXTENSION
  127.     FILE2 O_RD FOPEN ?FNF
  128.    ;
  129.  
  130.  
  131. : MAIN
  132.     HELLO
  133.     INITIALIZE-DATA
  134.     OPEN-FILES
  135.     COMPARE-SCREENS
  136.     bye
  137. ;
  138.  
  139.  
  140. INCLUDE DOS2
  141. INCLUDE FORTHLIB
  142. END
  143.